home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / fbuilder / delphi / fbcalc.pa1 < prev    next >
Encoding:
Text File  |  1996-09-15  |  25.7 KB  |  720 lines
  1. {
  2. //  FORMULABUILDER 1.0
  3. //  YGB Software, Inc.
  4. //  An Advanced Expression Evaluation Engine
  5. //  Copyright 1995 Clayton Collie, All Rights Reserved
  6. //
  7. //  Pascal Import unit for Formula Builder DLL
  8. //  Explicit Linking Version
  9. //
  10. //
  11. // NOTE! Included for informational purposes only ! DO NOT modify and
  12. // recompile, as this will cause a unit version mismatch error in the
  13. // component units.
  14. }
  15.  
  16. unit fbcalc;
  17. INTERFACE
  18. Uses Wintypes;
  19. CONST
  20.   FBuilderLib = 'FBCALC.DLL';
  21.  
  22. TYPE
  23.   Float      = Double;
  24.   TFBString  = PString;
  25.   {$IFDEF VER80}
  26.   TFBDate    = TDateTime;
  27.   {$ELSE}
  28.   TFBDate    = Double;
  29.   {$ENDIF}
  30.    HEXPR     = Longint;   { expression handle type }
  31.  
  32. CONST
  33.  
  34.    MAXFUNCPARAMS = 16;  { Functions can have up to MAXFUNCPARAMS parameters }
  35.  
  36.  
  37.   {::::::::::::::::::: Variable/Datatype constants:::::::::::::::::::::: }
  38.   { vtInteger .. vtClass taken from  \delphi\doc\system.int}
  39.  
  40.     vtINTEGER      = 0;
  41.     vtBOOLEAN      = 1;
  42.     vtCHAR         = 2;
  43.     vtFLOAT        = 3;
  44.     vtSTRING       = 4;
  45.     vtPOINTER      = 5;
  46.     vtPCHAR        = 6; { unused }
  47.     vtDATE         = 9;
  48.     vtBOOL         = 10;
  49.     vtANY          = 11;
  50.     vtNONE         = 13;
  51.     vtTypeClash    = 14;
  52.     vtTypeMismatch = vtTypeClash;
  53.  
  54. CONST
  55.     BOOLTRUE   = WORD(1);
  56.     BOOLFALSE  = WORD(0);
  57.  
  58. type
  59.     datatypes   = vtInteger .. vtNone;
  60.     datatypeset = set of Datatypes;
  61.  
  62. CONST
  63.       EXPR_SUCCESS                 =     1;
  64.       EXPR_MISSING_PAREN           =     2;
  65.       EXPR_BAD_EXPRESSION          =     3;
  66.       EXPR_BAD_ASSIGNMENT          =     4;
  67.       EXPR_UNKNOWN_IDENT           =     5;
  68.       EXPR_LINE_TOO_LONG           =     6;
  69.       EXPR_INVALID_TOKEN           =     7;
  70.       EXPR_INVALID_CHAR            =     8;
  71.       EXPR_MISSING_PARAM           =     9;
  72.       EXPR_TYPE_MISMATCH           =     10;
  73.       EXPR_INVALID_NUMBER          =     11;
  74.       EXPR_MISSING_VARIABLE        =     12;
  75.       EXPR_INVALID_VARIABLE        =     EXPR_MISSING_VARIABLE;  {CC}
  76.       EXPR_INVALID_FUNCTION        =     13;
  77.       EXPR_ZERO_DIVISION           =     14;
  78.       EXPR_STACK_OVERFLOW          =     15;
  79.       EXPR_UNEXPECTED_EOS          =     16;
  80.       EXPR_INVALID_DATE            =     17;
  81.       EXPR_IDENTIFIER_EXPECTED     =     18;
  82.       EXPR_RANGE_ERROR             =     19;
  83.       EXPR_DOMAIN_ERROR            =     20;
  84.       EXPR_MATH_ERROR              =     21;
  85.       EXPR_FP_OVERFLOW             =     22;
  86.       EXPR_FP_UNDERFLOW            =     23;
  87.       EXPR_INT_OVERFLOW            =     24;
  88.       EXPR_INVALID_OP              =     25;
  89.       EXPR_VARIABLE_EXPECTED       =     26;
  90.       EXPR_MISSING_OPERATOR        =     27;
  91.       EXPR_MISSING_OPERAND         =     28;
  92.       EXPR_CONSTANT_EXPECTED       =     29;
  93.       EXPR_DUPLICATE_IDENT         =     30;
  94.       EXPR_SYNTAX_ERROR            =     31;
  95.       EXPR_CONVERT_ERROR           =     32;
  96.       EXPR_INVALID_TYPE            =     33;
  97.       EXPR_INVALID_HANDLE          =     50;
  98.       EXPR_INVALID_CALLBACK        =     51;
  99.       EXPR_FORMULA_TOO_COMPLEX     =     54;
  100.  
  101.  
  102.  
  103. Const IDI_MAIN  = 1;
  104.       IDS_TRUE  = 2;
  105.       IDS_FALSE = 3;
  106.  
  107.  
  108. TYPE
  109. { General value structure }
  110.  
  111.  PValueRec = ^TValueRec;
  112.  TValueRec = record
  113.      flags : byte;
  114.      case vtype  : datatypes of
  115.        vtInteger : (vInteger    : Longint);
  116.        vtString  : (vpString    : TFBString);
  117.        vtBoolean : (vBoolean    : Boolean);
  118.        vtChar    : (vChar       : Char);
  119.        vtFloat   : (vFloat      : Float);
  120.        vtPChar   : (vpChar      : PChar);
  121.        vtPointer : (vPointer    : Pointer);
  122.        vtDate    : (vDate       : TFBDate);
  123.        vtBOOL    : (vBOOL       : BOOL);
  124.   end;
  125.  
  126.  
  127. {
  128.  // Callback definitions for variable & field implementation
  129. }
  130.  
  131. TYPE
  132.  TCBKGetVariable =
  133.    function(varname   : pchar;
  134.             var value : TValueRec;
  135.             vardata   : longint;
  136.             CBKData   : longint):integer;
  137.  
  138.  TCBKSetVariable =
  139.    function(varname : pchar;
  140.             value   : TValueRec;
  141.             vardata : longint;
  142.             CBKData : longint):integer;
  143.  
  144.  TCBKFindvariable =
  145.    function(varname      : pchar;
  146.             var vtype    : byte;
  147.             var VarData  : longint;
  148.             CBKData      : longint):integer;
  149.  
  150.  { function enumeration Callback }
  151.  
  152.  TCBKEnumFunctions =
  153.    function(vname : pchar;vtype : byte;parms : pchar;bMinPrms : byte;lEnumData : longint):integer;
  154.  
  155. {******************************************************
  156.  *  Declarations for external function implementation
  157.  ******************************************************}
  158.  
  159.  
  160. {
  161.  // Actual parameter list passed to external function callback
  162.  // The parser engine ensures that these match, in number and
  163.  // type, the prototype specified when the callback was registered
  164. }
  165.  
  166.  PActParamlist = ^TActParamlist;
  167.  TActParamList = array[0..MAXFUNCPARAMS-1] of TValueRec;
  168.  
  169.  
  170.  {
  171.  // Prototypes for external user-defined functions
  172.  // Implemented routine MUST use the EXPORT clause
  173.  }
  174.  
  175.   TCBKExternalFunc =
  176.      procedure(paramcount      : byte;
  177.                const params    : TActParamlist;
  178.                var   retvalue  : TValueRec;
  179.                var   errcode   : integer;
  180.                ExprData        : longint);
  181.      
  182. var
  183. {
  184. //
  185. //  Functions and Procedures
  186. //
  187. }
  188.  
  189.  {*----------------------------------------------*}
  190.  { Engine initialization and shutdown             }
  191.  {*----------------------------------------------*}
  192.  
  193.   FBInitExpression : Function(lExprData : longint) : longint;
  194.   FBFreeExpression : Function(handle : HEXPR)      : integer;
  195.  
  196.  
  197.  {::::::::::::::::::::: Expression Manipulation ::::::::::::::::::::}
  198.  
  199.   FBSetExpression     : Function(handle : HEXPR;expr : pchar):integer;
  200.   FBReparseExpression : Function(handle : HEXPR):integer;
  201.   FBClearExpression   : Function(handle : HEXPR) : integer;
  202.   FBGetExpression     : Function(handle : HEXPR;lpszBuf : pchar;wBuflen : word):integer;
  203.  
  204.  {::::::::::::::::::::: Expression Evaluation :::::::::::::::::::::::}
  205.  
  206.   { determine the result type of the expression. Returns one of the }
  207.   { vtXXX constants, vtTYPEMISMATCH for an invalid expression       }
  208.  
  209.   FBGetReturnType : Function(handle : HEXPR) : integer;
  210.  
  211. {
  212.  //  Evaluate the expression, returning a maximum of maxlen characters
  213.  // of the null-terminated string result in the buffer/string pointed to
  214.  //  by outbuf
  215. }
  216.  
  217.   FBEvaluate    : Function(handle : HEXPR;lpszBuf : pchar;wBuflen : word):integer;
  218.  
  219.  {*
  220.   * Evaluate the expression, returning the result in a TValueRec structure
  221.   * FBFreevalue should be used to dispose of any memory associated with value
  222.   * when it is no longer needed
  223.   *}
  224.  
  225.   FBEvaluatePrim : Function(handle : HEXPR;var value : TVALUEREC):integer;
  226.  
  227.  
  228.  {*  Dispose of any memory associated with a TValueRec structure *}
  229.  
  230.   FBFreeValue : Procedure(var Value : TValueRec);
  231.  
  232.  
  233.   FBCopyValue : Function(value : TValueRec):TValueRec;
  234.  
  235.  {*
  236.   *  Routines to get the expression results in primitive types
  237.   *}
  238.  
  239.   FBGetStringResult  : Function(handle : HEXPR;value : pchar;maxlen : word):integer;
  240.   FBGetFloatResult   : Function(handle : HEXPR;var value : double):integer;
  241.   FBGetBooleanResult : Function(handle : HEXPR;var value : BOOL):integer;
  242.   FBGetIntegerResult : Function(handle : HEXPR;var value : longint):integer;
  243.   FBGetDateResult    : Function(handle : HEXPR;var value : TFBDate):integer;
  244.  
  245.  {*======================================================================*}
  246.  { Perform a single operation expression evaluation. This is not the most  }
  247.  { efficient method of evaluation when the expression remains the same    }
  248.  {*======================================================================*}
  249.  
  250.   FBEvalExpression : Function(expr : pchar;var retType : datatypes;
  251.                               buf  : pchar;maxlen      : word):integer;
  252.  
  253.  {::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
  254.  { Internal Variable handling routines. NOTE ! If the variable callbacks are }
  255.  { implemented, the evaluation engine will not see the variables added       }
  256.  { by FBAddvariable                                                          }
  257.  {::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
  258.  
  259.  { Add a variable of type Vtype (see vtXXX constants) to the Expression Engine}
  260.  
  261.   FBAddVariable : Function(handle : HEXPR;vname  : pchar;vtype : byte):integer;
  262.  
  263.  {******************************************************************}
  264.  { Parse the string expression expr, and create a variable with its }
  265.  { type and value                                                   }
  266.  {******************************************************************}
  267.  
  268.   FBParseAddVariable : Function(handle : HEXPR;vname : pchar;expr : pchar): integer;
  269.  {*
  270.   * Set the value of variable vname from the string value
  271.   *
  272.   }
  273.   { Variable Setting }
  274.   FBSetVarFromString   : Function(handle : HEXPR;vname : pchar;value : pchar):integer;
  275.  
  276.   FBSetVariablePrim    : Function(handle : HEXPR;vname : pchar;value : TValueRec):integer;
  277.   FBSetStringVariable  : Function(handle : HEXPR;vname : pchar;value : pchar):integer;
  278.   FBSetIntegerVariable : Function(handle : HEXPR;vname : pchar;value : longint):integer;
  279.   FBSetFloatVariable   : Function(handle : HEXPR;vname : pchar;value : double):integer;
  280.   FBSetBooleanVariable : Function(handle : HEXPR;vname : pchar;value : BOOL):integer;
  281.   FBSetDateVariable    : Function(handle : HEXPR;vname : pchar;value : TFBDate):integer;
  282.  
  283.  { Get Variables }
  284.   FBGetVariablePrim    : Function(handle    : HEXPR;
  285.                               vname     : pchar;
  286.                               var Value : TValueRec):integer;
  287.  
  288.   FBGetVarAsString     : Function(handle : HEXPR;
  289.                                   vname  : pchar;
  290.                                   value  : pchar;
  291.                                   maxlen : word):integer;
  292.  
  293.  FBGetStringVariable   : Function(handle : HEXPR;vname : pchar;value : pchar;maxlen : word):integer;
  294.  FBGetIntegerVariable  : Function(handle : HEXPR;vname : pchar;var value : longint):integer;
  295.  FBGetFloatVariable    : Function(handle : HEXPR;vname : pchar;var value : double):integer;
  296.  FBGetBooleanVariable  : Function(handle : HEXPR;vname : pchar;var value : BOOL):integer;
  297.  FBGetDateVariable     : Function(handle : HEXPR;vname : pchar;var value : TFBDate):integer;
  298.  
  299.  
  300.  FBPeekVariable : Function(handle     : HEXPR;
  301.                            vno        : integer;
  302.                            vname      : pchar;
  303.                            maxlen     : word;
  304.                            var value  : TValueRec):integer;
  305.  
  306.  
  307.   FBPeekVarVB   : Function(handle     : HEXPR;
  308.                            vno        : integer;
  309.                            vname      : pchar;
  310.                            maxnamelen : word;
  311.                            var vtype  : integer;
  312.                            value      : pchar;
  313.                            maxvallen  : word):integer;
  314.  
  315.   FBGetVarPtr        : Function(handle : HEXPR;vname : pchar;var vtype : Byte;var value : pointer):integer;
  316.  
  317.   FBFreeVariable     : Function(handle : HEXPR;vname : pchar):integer;
  318.   FBFreeVariableList : Function(handle : HEXPR)  : Integer;
  319.   FBGetVariableCount : Function(handle : HEXPR)  : integer;
  320.  
  321. {:::::::::::::::::::::::: CONSTANTS :::::::::::::::::::::::::::::::::::}
  322.  
  323.   FBAddConstantPrim    : Function(cname : pchar;var value : TValueRec):Integer;
  324.   FBParseAddConstant   : Function(cname : pchar;expr : pchar):integer;
  325.   FBAddStringConstant  : Function(cname : Pchar;value : pchar):integer;
  326.   FBAddDateConstant    : Function(cname : Pchar;value : TFBDate):integer;
  327.   FBAddNumericConstant : Function(cname : Pchar;value : double):integer;
  328.   FBAddBooleanConstant : Function(cname : Pchar;value : BOOL):integer;
  329.   FBGetConstantPrim    : Function(cname : pchar;var Value : TValueRec):integer;
  330.   FBGetConstAsString   : Function(cname : pchar;lpszBuf : pchar;iBuflen : word):integer;
  331.   FBFreeConstant       : Function(cname  : pchar):integer;
  332.   FBFreeConstants      : Function : integer;
  333.  
  334. {::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
  335.  
  336.   {* Error handling *}
  337.   FBGetErrorString     : Procedure(Ecode : integer;buf : pchar;BufLen : word);
  338.  
  339.  {:::::::::::::::::::::: Callback Routines ::::::::::::::::::::::::::::::::}
  340.  
  341.  { Register functions to handle external variables. Setting callbacks overrides}
  342.  { the internal variable handling routines. All variables must be handled  }
  343.  { externally                                                              }
  344.  
  345.   FBSetVariableCallbacks : Function(handle     : HEXPR;
  346.                                    CBKVFind   : TCBKFindVariable;
  347.                                    CBKVGetval : TCBKGetVariable;
  348.                                    CBKVSetVal : TCBKSetVariable;
  349.                                    CBKData    : longint):integer;
  350. (*
  351.    FBSetFieldCallbacks : Function(handle     : HEXPR;
  352.                                   CBKFFind   : TCBKFindVariable;
  353.                                   CBKFGetval : TCBKGetVariable;
  354.                                   CBKFSetVal : TCBKSetVariable;
  355.                                   CBKData    : longint):integer;
  356.  
  357. *)
  358.   {::::::::::::::::: Function Management Routines::::::::::::::::::::}
  359.  
  360.   FBGetFunctionCount : Function : word;
  361.  
  362.   FBEnumFunctions    : Function(fncbk : TCBKEnumFunctions;lParam : longint):integer;
  363.  
  364.   FBRegisterFunction : Function(fname          : pchar;
  365.                                 returntype     : datatypes;
  366.                                 params         : pchar;
  367.                                 minparms       : integer;
  368.                                 func           : TCBKExternalFunc):integer;
  369.  
  370.  
  371.  {*
  372.   * Get the prototype for function named funcname. vType is one of the
  373.   * vtXXX constants, params is the list of parameters (Note that params
  374.   * must point to a buffer at least 17 bytes long). Minprms is the minimum
  375.   * number of allowable parameters to the function.
  376.   * Returns EXPR_INVALID_FUNCTION if funcname is not found.
  377.   *}
  378.   FBGetFunctionProto : Function(funcname      : pchar;
  379.                                 var vType     : byte;
  380.                                 params        : pchar;
  381.                                 var minPrms   : byte):integer;
  382.  
  383.  
  384.   FBUnRegisterFunction : Function(fnId : integer):integer;
  385.  
  386.   {*
  387.    * ::::::::::::::::: Utility Routines ::::::::::::::::::::::::
  388.    *}
  389.  
  390.   FBStrncpy           : Procedure(dest : pchar;source : TFBString;maxlen : word);
  391.   FBCreateString      : Function(str : pchar):TFBString;
  392.   FBlpzToDate         : Procedure(source : pchar;var value : TFBDate);
  393.   FBStringToDate      : Procedure(source : TFBString;var value : TFBDate);
  394.   FBPasStringToDate   : Function(const s : string):TFBDate;
  395.   FBStringFromLPZ     : Function(s : pchar):TFBString;
  396.   FBStringFromPas     : Function(s : string):TFBString;
  397.   FBStringToPasString : Function(s : TFBString):string;
  398.   FBDateToPasString   : Function(date : TFBDate):String;
  399.  { FBDateToLPZ}
  400.  
  401.  {}
  402.  Function DataTypeName(const vt : byte):string;
  403.  Function GetTypeNames(const types : datatypeSet):String;
  404.  function ValueAsString(const Fvalue : TValueRec): string;
  405.  
  406.  procedure InitFBuilder;
  407.  procedure FreeFBuilder;
  408.  Function  FBLoaded    : boolean;
  409.  Function  CheckLoadFB : Boolean;
  410.  
  411.  
  412. {* The Following is defined for the benefit of Delphi users.   *}
  413. {* Since the DLL is dynamically loaded and unloaded, we need a *}
  414. {* way to ensure that the DLL is not unloaded once it has been *}
  415. {* loaded in the Delphi form designer.                         *}
  416. {*                                                             *}
  417. {* When the usage count for the DLL reaches 0, the _DesignMode_*}
  418. {* variable is checked. The DLL is unloaded only if it is FALSE*}
  419. {*                                                             *}
  420. {* This variable is automatically set by the FormulaBuilder    *}
  421. {* components, and should not be used otherwise                *}
  422. VAR
  423.   _DesignMode_ : boolean;
  424.  
  425.  
  426. IMPLEMENTATION
  427. uses sysutils,winprocs;
  428. {$F+}
  429. {$IFDEF WIN32}
  430. VAR
  431. {$ELSE}
  432. CONST
  433. {$ENDIF}
  434.        Loaded      : boolean = false;
  435.        FBHandle    : THandle = 0;
  436.        UseCount    : longint = 0;
  437.  
  438. function  ValueAsString(const Fvalue : TValueRec): string;
  439. begin
  440.   result := '';
  441.   with fvalue do
  442.   case vtype of
  443.     vtInteger    : result := inttostr( vInteger );
  444.     vtBoolean    : if vBoolean then
  445.                      result := 'TRUE' else Result := 'FALSE';
  446.     vtChar       : result := vChar;
  447.     vtFloat      : result := FloatToStr( vFloat );
  448.     vtString     : if assigned(vpString) then result := vpString^ ;
  449.     vtPChar      : result := StrPas( vPChar );
  450.     vtDate       : begin
  451.                      if Int(vdate) > 0 then
  452.                      begin
  453.                        if Frac(vdate) > 0 then
  454.                           Result := DateTimeToStr(vDate)
  455.                         else
  456.                           Result := DateToStr(vDate)
  457.                      end
  458.                     else
  459.                      Result := TimeToStr(vDate)
  460.                    end;
  461.      vtBool      : result := inttostr( WORD(vBool) );
  462.   end;
  463. end;
  464.  
  465.  
  466.  
  467. Function DataTypeName(const vt : byte):string;
  468. begin
  469.   result := '';
  470.   case vt of
  471.      vtInteger : result := 'Integer';
  472.      vtBoolean : result := 'Boolean';
  473.      vtFloat   : result := 'Float';
  474.      vtChar    : result := 'Char';
  475.      vtString  : result := 'String';
  476.      vtDate    : result := 'Date/Time';
  477.      vtAny     : result := 'Any';
  478.   end;
  479. end;
  480.  
  481.  
  482. Function gettypeNames(const types : datatypeSet):String;
  483. var 
  484.     msg   : string[50];
  485.     i,ret : datatypes;
  486.  
  487.  
  488.     Function CheckSingleType( typ : datatypes ):boolean;
  489.     begin
  490.       if (types = [typ]) then
  491.       begin
  492.         msg    := DatatypeName(typ);
  493.         result := True;
  494.       end
  495.      else
  496.       result := false;
  497.     end;
  498.  
  499.     Function CollectTypenames : string;
  500.     var i : datatypes;
  501.         matchcnt,count : byte;
  502.     begin
  503.       matchcnt := 0;
  504.       for i := vtINTEGER to vtANY do
  505.           inc(matchCnt,ord(i in types));
  506.       count  := 0;
  507.       result := '';
  508.       for i := vtINTEGER to vtANY do
  509.       begin
  510.           if (i in types) then
  511.           begin
  512.             result := result + Datatypename(i);
  513.             inc(count);
  514.             if (count < matchcnt) then
  515.             begin
  516.               if (count = (MatchCnt-1)) then
  517.                  result := result + ' or '
  518.                else
  519.                  if (count <> MatchCnt) then
  520.                     result := result + ', '
  521.             end;
  522.            end;
  523.       end;
  524.     end; { CollectTypenames }
  525.  
  526. begin
  527.   msg := '';
  528.   for i := vtINTEGER to vtANY do
  529.       if  CheckSingletype( I ) then break;
  530.   result := msg;
  531.   if (msg = '') then
  532.   begin
  533.     if (types = [vtINTEGER,vtFLOAT]) then
  534.        Result := 'Numeric'
  535.      else
  536.       if (types = [vtBOOL,vtBOOLEAN]) then
  537.           result := DataTypeName(vtBOOLEAN)
  538.         else
  539.           result := CollectTypeNames;
  540.   end;
  541. end; { gettypenames }
  542.  
  543.  
  544.  
  545.  {
  546.  // Retrieve the address of the DLL's exported routines.
  547.  }
  548.   Procedure LoadRoutines;
  549.   begin
  550.     @FBInitExpression    := GetProcAddress(FBHandle,'FBInitExpression');
  551.     @FBFreeExpression    := GetProcAddress(FBHandle,'FBFreeExpression');
  552.     @FBSetExpression     := GetProcAddress(FBHandle,'FBSetExpression');
  553.     @FBReparseExpression := GetProcAddress(FBHandle,'FBReparseExpression');
  554.     @FBGetExpression     := GetProcAddress(FBHandle,'FBGetExpression');
  555.     @FBClearExpression   := GetProcAddress(FBHandle,'FBClearExpression');
  556.     @FBGetReturnType     := GetProcAddress(FBHandle,'FBGetReturnType');
  557.     @FBEvaluate          := GetProcAddress(FBHandle,'FBEvaluate');
  558.     @FBEvaluatePrim      := GetProcAddress(FBHandle,'FBEvaluatePrim');
  559.     @FBFreeValue         := GetProcAddress(FBHandle,'FBFreeValue');
  560.     @FBGetStringResult   := GetProcAddress(FBHandle,'FBGetStringResult');
  561.     @FBGetFloatResult    := GetProcAddress(FBHandle,'FBGetFloatResult');
  562.     @FBGetBooleanResult  := GetProcAddress(FBHandle,'FBGetBooleanResult');
  563.     @FBGetIntegerResult  := GetProcAddress(FBHandle,'FBGetIntegerResult');
  564.     @FBGetDateResult     := GetProcAddress(FBHandle,'FBGetDateResult');
  565.     @FBEvalExpression    := GetProcAddress(FBHandle,'FBEvalExpression');
  566.     @FBAddVariable       := GetProcAddress(FBHandle,'FBAddVariable');
  567.     @FBParseAddVariable  := GetProcAddress(FBHandle,'FBParseAddVariable');
  568.     @FBSetVariablePrim   := GetProcAddress(FBHandle,'FBSetVariablePrim');
  569.     @FBSetVarFromString  := GetProcAddress(FBHandle,'FBSetVarFromString');
  570.     @FBSetIntegerVariable:= GetProcAddress(FBHandle,'FBSetIntegerVariable');
  571.     @FBSetStringVariable := GetProcAddress(FBHandle,'FBSetStringVariable');
  572.  
  573.     @FBSetFloatVariable  := GetProcAddress(FBHandle,'FBSetFloatVariable');
  574.     @FBSetBooleanVariable:= GetProcAddress(FBHandle,'FBSetBooleanVariable');
  575.     @FBSetDateVariable   := GetProcAddress(FBHandle,'FBSetDateVariable');
  576.  
  577.     @FBGetVariablePrim   := GetProcAddress(FBHandle,'FBGetVariablePrim');
  578.     @FBGetVarAsString    := GetProcAddress(FBHandle,'FBGetVarAsString');
  579.     @FBGetStringVariable := GetProcAddress(FBHandle,'FBGetStringVariable');
  580.     @FBGetIntegerVariable:= GetProcAddress(FBHandle,'FBGetIntegerVariable');
  581.     @FBGetFloatVariable  := GetProcAddress(FBHandle,'FBGetFloatVariable');
  582.     @FBGetBooleanVariable:= GetProcAddress(FBHandle,'FBGetBooleanVariable');
  583.     @FBGetDateVariable   := GetProcAddress(FBHandle,'FBGetDateVariable');
  584.     @FBPeekVariable      := GetProcAddress(FBHandle,'FBPeekVariable');
  585.     @FBPeekVarVB         := GetProcAddress(FBHandle,'FBPeekVarVB');
  586.     @FBGetVarPtr         := GetProcAddress(FBHandle,'FBGetVarPtr');
  587.     @FBFreeVariable      := GetProcAddress(FBHandle,'FBFreeVariable');
  588.     @FBFreeVariableList  := GetProcAddress(FBHandle,'FBFreeVariableList');
  589.     @FBGetVariableCount  := GetProcAddress(FBHandle,'FBGetVariableCount');
  590.  
  591.    {::: CONSTANTS ::::::}
  592.     @FBAddConstantPrim     := GetProcAddress(FBHandle,'FBAddConstantPrim');
  593.     @FBParseAddConstant    := GetProcAddress(FBHandle,'FBParseAddConstant');
  594.     @FBAddStringConstant   := GetProcAddress(FBHandle,'FBAddStringConstant');
  595.     @FBAddDateConstant     := GetProcAddress(FBHandle,'FBAddDateConstant');
  596.     @FBAddNumericConstant  := GetProcAddress(FBHandle,'FBAddNumericConstant');
  597.     @FBAddBooleanConstant  := GetProcAddress(FBHandle,'FBAddBooleanConstant');
  598.     @FBGetConstantPrim     := GetProcAddress(FBHandle,'FBGetConstantPrim');
  599.     @FBGetConstAsString    := GetProcAddress(FBHandle,'FBGetConstAsString');
  600.     @FBFreeConstant        := GetProcAddress(FBHandle,'FBFreeConstant');
  601.     @FBFreeConstants       := GetProcAddress(FBHandle,'FBFreeConstants');
  602.   {:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
  603.     @FBGetErrorString      := GetProcAddress(FBHandle,'FBGetErrorString');
  604.     @FBSetVariableCallbacks:= GetProcAddress(FBHandle,'FBSetVariableCallbacks');
  605.  (* @FBSetFieldCallbacks   := GetProcAddress(FBHandle,'FBSetFieldCallbacks'); *)
  606.     @FBGetFunctionCount    := GetProcAddress(FBHandle,'FBGetFunctionCount');
  607.     @FBEnumFunctions       := GetProcAddress(FBHandle,'FBEnumFunctions');
  608.     @FBGetFunctionProto    := GetProcAddress(FBHandle,'FBGetFunctionProto');
  609.     @FBRegisterFunction    := GetProcAddress(FBHandle,'FBRegisterFunction');
  610.     @FBUnregisterFunction  := GetProcAddress(FBHandle,'FBUnregisterFunction');
  611.     @FBStrncpy             := GetProcAddress(FBHandle,'FBStrncpy');
  612.     @FBCreateString        := GetProcAddress(FBHandle,'FBCreateString');
  613.     @FBCopyValue           := GetProcAddress(FBHandle,'FBCopyValue');
  614.  
  615.     @FBlpzToDate           := GetProcAddress(FBHandle,'FBlpzToDate');
  616.     @FBStringToDate        := GetProcAddress(FBHandle,'FBStringToDate');
  617.     @FBStringFromLPZ       := GetProcAddress(FBHandle,'FBStringFromLPZ');
  618.     @FBStringFromPas       := GetProcAddress(FBHandle,'FBStringFromPas');
  619.     @FBStringToPasString   := GetProcAddress(FBHandle,'FBStringToPasString');
  620.     @FBDateToPasString     := GetProcAddress(FBHandle,'FBDateToPasString');
  621.     @FBPasStringToDate     := GetProcAddress(FBHandle,'FBPasStringToDate');
  622.  end; { LoadRoutines }
  623.  
  624.  
  625.  
  626.  
  627.  
  628. procedure InitFBuilder;
  629. var
  630.   ErrMode : Word;
  631.   Version : Longint;
  632.  
  633. begin
  634.   if FBHandle = 0 then
  635.   begin
  636.     ErrMode  := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  637.     FBHandle := LoadLibrary(FBuilderLib);
  638.     SetErrorMode(ErrMode);
  639.     if FBHandle < 32 then FBHandle := 1;
  640.     if FBHandle >= 32 then
  641.     begin
  642.        LoadRoutines;
  643.        useCount := 1;
  644.     end
  645.   else
  646.     begin
  647.       FreeLibrary(FBHandle);
  648.       FBHandle := 1;    { 1 = cannot load }
  649.       Raise Exception.CreateFmt(' Error Loading %s ',[FBuilderLib]);
  650.     end;
  651.   end
  652.  else
  653.   if (FBHandle >= 32) then
  654.      Inc(UseCount);
  655. end;
  656.  
  657.  
  658. procedure FreeFBuilder;
  659. var tmpcount : integer;
  660. begin
  661.   if UseCount > 0 then
  662.   begin
  663.     Dec(UseCount);
  664.     if (useCount = 0) and (FBHandle >= 32) then {unload the DLL}
  665.     begin
  666.       { For Delphi, make sure were not in design mode. _DesignMode_  }
  667.       { is set by the component code in FBCOMP }
  668.       if not _DesignMode_ then
  669.       begin
  670.          tmpcount := GetModuleUsage(fbHandle);
  671.          if tmpCount > 0 then
  672.          begin
  673.            FreeLibrary(FBHandle);
  674.            FBHandle := 0;
  675.          end;
  676.       end;
  677.     end;
  678.   end;
  679. end; { FReeBuilder }
  680.  
  681.  
  682.   Function CheckLoadDLL : Boolean;
  683.   begin
  684.     if (FBHandle < 32) then
  685.        InitFBuilder;
  686.     result := FBHandle >= 32;
  687.   end;
  688.  
  689.  
  690.   Function CheckUnloadDLL : boolean;
  691.   begin
  692.     if (fBhandle >= 32) then
  693.     begin
  694.       Result := true;
  695.       FreeFBuilder;
  696.     end;
  697.   end;
  698.  
  699.  
  700.   Procedure ExitUnloadDLL; far;
  701.   begin
  702.     while (UseCount > 0) do FreeFBuilder;
  703.   end;
  704.  
  705.   Function FBLoaded : boolean;
  706.   begin
  707.     FBLoaded := (fBHandle >= 32);
  708.   end;
  709.  
  710.   Function CheckLoadFB : boolean;
  711.   begin
  712.     if not FBLoaded then
  713.        InitFbuilder;
  714.     result := FBLoaded;
  715.   end;
  716.  
  717. begin
  718.   _DesignMode_ := false;
  719. END.
  720.